;;; -*-Midas-*-
;;; Copyright (c) 1999 Massachusetts Institute of Technology
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, see https://gnu.org/licenses or
;;; write to:
;;;  Free Software Foundatiom, Inc.
;;;  51 Franklin St, Fifth Floor
;;;  Boston, MA 02110-1301
;;;  USA


TITLE DSKDMP

.MLLIT==1

DEFINE SETF TEXT,FLG
IFDEF FLG,.STOP
.TAG FOOBAR 
PRINTC "TEXT
FLG="
.TTYMAC FLAG
.TTYFLG==.TTYFLG+1
PRINTX/FLAG
/
.TTYFLG==.TTYFLG-1
IFSE FLAG,YES,FLG==1
IFSE FLAG,NO,FLG==0
IFSE FLAG,Y,FLG==1
IFSE FLAG,N,FLG==0
IFNDEF FLG,FLG==FLAG
TERMIN
IFNDEF FLG,.GO FOOBAR
TERMIN

IF1,[
PRINTC "Configuration (KSRP06, KSRM03, or ASK) ? " 
.TTYMAC MACH
IFSE MACH,KSRP06,[
	HRIFLG==0
	RP06P==1
	KS10P==1
	NUDSL==500.
] ;KSRP06
IFSE MACH,KSRM03,[
	HRIFLG==0
	RP06P==0
	RM03P==1
	KS10P==1
	NUDSL==500.
] ;KSRM03
IFSN MACH,ASK,[
IFNDEF NUDSL,[ PRINTC /No known configuration for "MACH".
/ ]]
TERMIN
] ;IF1

SETF [Readin Mode Paper Tape?]HRIFLG
SETF [Assemble BOOT? (If no, full DSKDMP)]BOOTSW

SETF [RH11/RP06 disk system?]RP06P
IFE RP06P,[
SETF [RH11/RM03 disk system?]RM03P
IFE RM03P,[
SETF [RH10 (MC-KL) disk control?]RH10P
IFE RH10P,[
SETF [AIKA disk control? (no => RP02/RP03)]DC10P
]]]
IFN RP06P, RM03P==0
IFN RP06P+RM03P, RH10P==0
IFN RP06P+RM03P+RH10P, DC10P==0
IFN RP06P+RM03P+RH10P+DC10P, RP10P==0
IFE RP06P+RM03P+RH10P+DC10P, RP10P==1

IFE BOOTSW, SETF [Number of dirs? (DM-KA: 200., ML-KA: 250., AI-KA: 440., all others: 500.)]NUDSL

SETF [KS10 processor?]KS10P
IFE KS10P, SETF [KL10 processor? (no => KA10)]KL10P
IFN KS10P, KL10P==0
IFN KS10P+KL10P, KA10P==0
IFE KS10P+KL10P, KA10P==1

DEFINE RP
IFN RP10P!TERMIN
DEFINE SC
IFN DC10P!TERMIN
DEFINE RH
IFN RH10P!TERMIN
DEFINE PH
IFN RP06P+RM03P!TERMIN

DEFINE KA
IFN KA10P!TERMIN
DEFINE KL
IFN KL10P!TERMIN
DEFINE KS
IFN KS10P!TERMIN

IFN HRIFLG,[
NOSYMS			;MAKE PAPER TAPE SHORTER
RIM10
]

C=1			;C-A-B FOR LINKS
A=2
B=3
D=4
BLKIN=5			;PSEUDO-CORE BLOCK IN CBUF
WRITE=6			;NEG MEANS DUMP, RH 0 OR WRBIT
DIFF=7			;DIFF CONO ALSO TEMP
HEAD=10			;HEAD CONO ALSO TEMP
P=11			;JSP AC
BLOK=12
UNIT=13			;UNIT AND M.A. DATAO
CMD=14			;COMMAND CHAR
T=15			;VERY TEMP
TT=16			;ANOTHER JSP AC, ALSO VERY TEMP
BUFP=17			;DBUF PNTR--LAST WORD USED

IF1,[			;DON'T TAKE A WEEK AND A HALF TO ASSEMBLE.
RP, .INSRT SYSTEM;RP10 >
SC, .INSRT SYSTEM;DC10 >
RH, .INSRT SYSTEM;RH10 >
IFN RP06P, .INSRT SYSTEM;RH11 >
IFN RM03P, .INSRT SYSTEM;RM03 >
IFE BOOTSW, .INSRT SYSTEM;FSDEFS >
IFE BOOTSW, KL,	.INSRT SYSTEM;EPT >
KS, .INSRT SYSTEM;KSDEFS >
KA, TTY==120
]

;PARAMETER FILE FOR DSKDMP

MEMSIZ=1000000 		;ACTUAL SIZE OF MEM
IFNDEF DBGSW,DBGSW==0	;1 TO DEBUG THIS WITH DDT
DDT==MEMSIZ-4000
IFN DBGSW,MEMSIZ==MEMSIZ-10000	;MOVE DOWN UNDER DDT IF DEBUG MODE
CORE==MEMSIZ-10000-<2000*NTUTBL>		;HIGHEST ADR ALWAYS IN CORE+1
CORES==CORE_<-12>	;BLK # OF ABOVE (FIRST OF BLKS SWAPPED OUT FOR BUFFER AREAS)
NSWBL==4+NTUTBL		;# BLOCKS SWAPPED OUT FOR BUFFER AREAS, +1 FOR DSKDMP ITSELF
HIGH==MEMSIZ-100	;HIGHEST ADR LOADED/DUMPED+1

NDSK==8			;MAX POSSIBLE.  L$n$ DEFINES WHICH ARE REALLY THERE
RP,ICWA=34
RH,ICWA=34

PH, UBPG==:17		; Use last (usable) page in Unibus map

KA, LPM=102000,,
KA, LPMR=LPM 2,
KL, PAG=<BLKI 10,>-<BLKI>

DEFINE INFORM A,B
IF1,[ PRINTX  A = B
] TERMIN

;COMMANDS ARE:
;   L$file	LOAD FILE INTO CORE
;   T$file	LOAD FILE INTO CORE AND GIVE SYMBOLS TO DDT AND START DDT
;   M$file	LOAD FILE INTO CORE WITHOUT CLEARING CORE FIRST, DOESN'T LOAD SYMBOLS
;   K$file	DELETE FILE
;   D$file	DUMP CORE INTO FILE
;   I$file	VERIFY FILE AGAINST CORE
;   G$		START AT STARTING ADDRESS
;   U$dir;	LIST DIRECTORY
;   F$		LIST CURRENT DIRECTORY
;   S$		LIST PACK IDS THEN MFD
;   nnn$	SET STARTING ADDRESS TO nnn
;   L$n$	PUT DISK n ONLINE
;   K$n$	TAKE DISK n OFFLINE

;ERROR MESSAGES ARE:
;   CMPERR	VERIFY FAILED TO MATCH
;   DIRFUL	DIRECTORY FULL
;   EOF		UNEXPECTED EOF
;   DIRNF	DIRECTORY DOES NOT EXIST
;   FNF		FILE NOT FOUND
;   PKNMTD	FILE IS ON PACK THAT IS NOT MOUNTED
;   CKSERR	CHECKSUM ERROR
;   DSKFUL	DISK FULL
;   NODDT	CAN'T ADDRESS DDT SYMBOL TABLE (BUG)
;   ?BUG?	BUG
;   SEEKFL	DISK SEEK ERROR
;   CLOBRD	DISK READ ERROR
;   CLOBWR	DISK WRITE ERROR
;   DIRCLB	DIR NAME DIFFERS, TUT DISAGREES WITH DIR
;   MFDCLB	M.F.D. CLOBBERED
;   DSKLUZ	DISK LOSSAGE (OFFLINE OR UNSAFE OR MASSBUS ERROR)

KS,	LOC 4000		; Avoid MTBOOT and KSRIM

IFE BOOTSW,[
ZZZ:	IFE DBGSW,[
	MOVE T,....		;THIS CODE BLTS THE FOLLOWING OFFSET CODE
	BLT T,MEMSIZ-1-1	;INTO HIGH MEMORY AND WRITES DSKDMP ON ITS
	MOVE T,PROG+MEMSIZ-2-BEG+1
	MOVEM T,BEG+MEMSIZ-2-BEG+1	;AVOID LOSING DUE TO -1 BLT LOSSAGE
]
	MOVSI T,-NDSK+1		;MAKE ALL BUT DISK 0 BE DEAD (MUST DO L$ TO MAKE THEM ALIVE)
	SETOM QDED+1(T)
	MOVNS QDED+1(T)
	AOBJN T,.-2
	SETZM QDED+0
RP,[	MOVEI T,ICWA+2		;SET UP CHANNEL JUMP
	MOVEM T,ICWA 		;IN INITIAL CHANNEL ADDRESS
	SETZM ICWA+1 		;AND CLEAR REMAINING STUFF
	SETZM ICWA+3
	DATAO DPC,SUNIT0
	DATAI DPC,B
	TRNN B,RP03BT
	 JRST WBOOT1
	MOVEI B,MBLKS		;UNIT 0 IS AN RP03, ADJUST WORLD
	HRRM B,CBLK
	MOVE B,RP3ADJ
	MOVSI A,-NSWBL
	XORM B,SWPSK(A)
	AOBJN A,.-1
WBOOT1:	HLLZS BOOT0
	MOVEI UNIT,BEG		;MAGIC BLOCK THEN STARTS IT
	HRRZ BLOK,CBLK
	ADDI BLOK,NSWBL		;FIRST BLOCK AFTER CORE BUFFER IS WHERE DSKDMP LIVES
	MOVEI WRITE,10
	JSP TT,WRD3
	HRRZ BLOK,CBLK
	ADDI BLOK,NSWBL+1
	MOVEI WRITE,10
	JSP TT,WRD3
	CONSZ DPC,ALLER
IFN DBGSW,JRST DDT
IFE DBGSW,JRST 4,. 		;FORMERLY JRST MEMSIZ-400 (??)
	JRST BEG
];RP
PH,[	MOVEI T,%HYCLR		; Clear controller
	IOWRQ T,%HRCS2		; (Selects drive 0)
WBOOT0:	IORDQ T,%HRCS1
	TRNN T,%HXDVA
	 JRST WBOOT0		; Await drive available (well, it is a dual
				; ported drive...  perhaps someday?)
	MOVEI UNIT,BEG
	HRRZ BLOK,CBLK
	ADDI BLOK,NSWBL		; FIRST BLOCK AFTER CORE BUFFER IS WHERE
				; DSKDMP LIVES
	MOVEI WRITE,10
	JSP TT,WRD3
	HRRZ BLOK,CBLK
	ADDI BLOK,NSWBL+1
	MOVEI WRITE,10
	JSP TT,WRD3
	IORDQ TT,%HRCS1
	TRNE TT,%HXTRE+%HXMCP
IFN DBGSW, JRST DDT
IFE DBGSW, JRST 4,. 		; Formerly JRST MEMSIZ-400 (??)
	JRST BEG
];PH
RH,[	MOVEI T,ICWA+2		;SET UP CHANNEL JUMP
	MOVEM T,ICWA 		;IN INITIAL CHANNEL ADDRESS
	SETZM ICWA+1 		;AND CLEAR REMAINING STUFF
	SETZM ICWA+3
WBOOT0:	DATAO DSK,[%HRDCL,,]
	MOVEI A,20
	SOJG A,.
	DATAI DSK,A
	TRNN A,%HCDVA
	 JRST WBOOT0		;AWAIT DRIVE AVAILABLE
	MOVEI UNIT,BEG		;MAGIC BLOCK THEN STARTS IT
	HRRZ BLOK,CBLK
	ADDI BLOK,NSWBL		;FIRST BLOCK AFTER CORE BUFFER IS WHERE DSKDMP LIVES
	MOVEI WRITE,10
	JSP TT,WRD3
	HRRZ BLOK,CBLK
	ADDI BLOK,NSWBL+1
	MOVEI WRITE,10
	JSP TT,WRD3
	CONSZ DSK,%HIERR
IFN DBGSW,JRST DDT
IFE DBGSW,JRST 4,. 		;FORMERLY JRST MEMSIZ-400 (??)
	JRST BEG
];RP
SC,[	MOVEI UNIT,BEG		;MAGIC BLOCK THEN STARTS IT
	MOVEI BLOK,NBLKS+NSWBL
	MOVEI WRITE,60
	JSP TT,WRD3
	MOVEI BLOK,NBLKS+NSWBL+1
	MOVEI WRITE,60
	JSP TT,WRD3
	DATAO DC0,.....
	CONSZ DC0,DSSACT
	JRST .-1
	CONSZ DC0,DSSERR
IFN DBGSW,JRST DDT
IFE DBGSW,JRST 4,. 		;FORMERLY JRST MEMSIZ-400 (??)
	JRST BEG

.....:	DJMP .+1
	DWRITE
	DCOPY ......(-LRIBLK_2&37774)
	DHLT

......:	DWRITE+DUNENB+DADR		;FOR READIN
	DCOPY BEG(-2000_2&37774)
	DREAD+DADR1
	DCOPY BEG(-2000_2&37774)
	DHLT
];SC

IFE DBGSW,[
....:	PROG,,BEG

KA,	LOC 2000		; MAKE OFFSET CONVENIENT
KL,	LOC 2000
KS,	LOC 6000		; Avoid MTBOOT and KSRIM
PROG:	OFFSET CORE+<<NSWBL-1>*2000>-.
]IFN DBGSW,LOC MEMSIZ-2000

BEG:
KA,[	CONO 635550 		;ENTER HERE, CLEAR WORLD
	JRST .+1
	JFCL 1,[JRST 4,.]	;A PDP6??
	LPMR [0]-2 		;TURN OFF EXEC PAGING
]
KL,[	CONO 327740		;CLEAR APR
	CONSZ PAG,660000	;PAGING AND CACHE BETTER BE OFF
	 JRST 4,.
]
KS,[	CONO 127760		; Enable, and Clear all.
	RDEBR B
	TRNE B,60000		; Paging and Tops-20 better be off.
	 JRST 4,.
	SETZM 8SWIT0		; Clear 8080 Communications area to prevent
	MOVE B,[8SWIT0,,8SWIT0+1]	; mysterious IO behavior.
	BLT B,8RHBAS-1
	;; If the machine has just been powered on, there is likely to be
	;; bad parity all over the place.  I guess that isn't our problem
	;; as long as we don't touch any of it...
]
	MOVSI B,-NDSK 		;FOR NUMBER OF DISKS
	SETOM PKNUM(B)		;SET DISK TO UNKNOWN
	AOBJN B,.-1
	MOVE T,[JRST LOADG1]	;SET BOOTSTRAP TO MIDDLE OF WORLD
	MOVEM T,BOOT
	MOVE D,['DSKDMP]	;ANNOUNCE SELF
	JSP TT,PD
	JRST READ		;CRLF AND BEGIN READING COMMANDS

ERROR:	0
	CLEARM MEMSIZ-1 	;DON'T READ ANY MORE COMMANDS FROM MEMORY
	SOS T,ERROR 		;PICK UP ERROR CODE FROM THE AC FIELD OF
	LDB T,[270400+T,,]	;THE JSR ERROR
	MOVE D,ERMESS(T)
	JSP TT,PD 		;PRINT OUT APPROPRIATE COMMENT
	CAIL T,EBUG
	 JRST READ 		;BAD ERROR - NO MORE DISKING
LOADG1:
KA,	DATAI TTY,C 		;FLUSH RANDOM CHARACTER
KS,	SETZM 8CTYIN		; ".RESET"
	TRO CMD,10 		;MAKE SURE PSEUDO-CORE IN CORE
	JRST LOADG 		;BY SIMULATING END OF LOADING, NON-GOING COMMAND

ERMESS:	IRP XX,,[ECMP,EDIR,EEOF,ESNF,EFNF,EPNM,ECKS
EDSK,EDDT,EBUG,EC63,ECRD,ECWR,ECDR,EMFC,EDLZ]YY,,[CMPERR,DIRFUL
EOF,DIRNF,FNF,PKNMTD,CKSERR,DSKFUL,NODDT,?BUG?,SEEKFL
CLOBRD,CLOBWR,DIRCLB,MFDCLB,DSKLUZ]
XX==.-ERMESS
	SIXBIT \YY\
TERMIN

PD:	JSP P,CRLF 		;TYPE A CR
PD2:	MOVEI C,40
	JSP P,TYO 		;AND A SPACE
	MOVE B,[440600,,D]
PD1:	ILDB C,B 		;AND THE SIXBIT CONTENTS OF D
	ADDI C,40
	JSP P,TYO
	TLNE B,770000
	 JRST PD1
	JRST (TT)

PNO:
C12:	IDIVI C,10. 		;PRINT CONTENTS OF C AS A TWO-DIGIT
	DPB C,[60600,,A]	;DECIMAL NUMBER PRECEDED
	MOVEI D,(SIXBIT /#00/+A) ;BY <SPACE>#
	MOVE B,[300600,,D]
	JRST PD1

WRCB:	MOVEI UNIT,CBUF		;WRITE OUT CONTENTS OF CBUF
	LSH BLKIN,-12		;ON APPROPRIATE BLOCK
	HRRZ BLOK,CBLK
	ADDI BLOK,-CORES(BLKIN)
	JRST WRM

LODUMP:	MOVEI UNIT,CORE		;DEPENDING ON SIGN BIT OF WRITE, LOAD OR DUMP
	HRRZ BLOK,CBLK		;PSEUDO-CORE (766000-775777)
LODMP1:	JSP TT,WRDM
	ADDI UNIT,2000
	CAIGE UNIT,BEG
	 AOJA BLOK,LODMP1
	MOVEI BLKIN,CORE
	JRST (P)

FD:	HRRZ C,B 		;SET UP POINTER IN C TO FETCH OR DEPOSIT
	  			;CONTENTS OF ADDRESS IN RIGHT HALF OF B
IFN DBGSW, SKIPGE WRITE		;LOAD DDT WHEN IN DEBUG MODE
	CAIGE C,HIGH
	CAIGE C,40
	 JRST (P)
	CAIGE C,CORE 		;IF ADDR IS IN REAL CORE, RETURN IMMEDIATELY
	 JRST 1(P)
FDX:	CAIL C,(BLKIN)		;ADDR IS IN PSEUDO-CORE--CHECK IF RIGHT
	CAILE C,1777(BLKIN)	;BLOCK IS IN CBUF
	 JRST FD3 		;IT'S NOT THERE--READ IT IN
FD4:	SUBI C,-CORE(BLKIN)	;IT'S THERE--SET UP RIGHT POINTER IN C
	JRST 1(P) 		;AND RETURN
FD3:	JUMPLE WRITE,FD3A	;IF DUMP OR VERIFY DON'T BOTHER
	  			;TO WRITE OUT CURRENT BLOCK
FD3B:	JSP TT,WRCB 		;IF LOAD, WRITE CURRENT BLOCK FIRST
FD3A:	MOVEI UNIT,CBUF
	MOVE BLKIN,C
	ANDI BLKIN,776000
	LDB BLOK,[121000,,BLKIN]
	ADD BLOK,CBLK
	MOVEI BLOK,-CORES(BLOK)
	JSP TT,RDM 		;READ IN CORRECT BLOCK
	JRST FD4 		;SET UP POINTER AND RETURN

GBP:	IDIVI C,6 		;TURN USER DIRECTORY CHARACTER ADDR IN C
	IMULI A,-60000		;INTO A BYTE POINTER
	HRLI C,440600(A)
	ADDI C,DIR+UDDESC
	JRST (TT)

WD:	AOBJN BUFP,WD1		;READ, WRITE, OR VERIFY WORD IN D FROM, INTO,
	JSP TT,NXTBLK		;OR AGAINST WORD IN DBUF
	JSP TT,WRDB 		;TIME TO REFILL OR EMPTY DBUF
	MOVSI BUFP,-2000	;RESET BUFFER POINTER
WD1:	JUMPG WRITE,WD2		;JUMP ON LOAD
	JUMPL WRITE,WD3		;JUMP ON WRITE
	CAME D,DBUF(BUFP)	;HERE IF VERIFY
	 JSR ECMP,ERROR		;VERIFY COMPARE LOST
	JRST (P)
WD2:	SKIPA D,DBUF(BUFP)	;LOAD
WD3:	 MOVEM D,DBUF(BUFP)	;DUMP
	JRST (P)

NXTTUT:	HRRZ B,CU 		;SELECT NEXT UNIT AND READ ITS TUT
	AOJ B,
	CAIN B,NDSK
	 MOVEI B,0
	HRRM B,CU
	CAIN B,@MU
	 JRST 1(TT) 		;SKIP IF NO MORE
	SKIPE QDED(B)
	 JRST NXTTUT 		;UNIT NOT ON LINE
RDTUT:	MOVEI BLOK,TUTBLK	;READ TUT OF CURRENT UNIT
	MOVEI UNIT,TUT
	SETOM PKNUM(B)		;ALWAYS READ HEADER FOR TUT
IFG NTUTBL-1,[			;READ IN MULTI-BLOCK TUT
	HRRM TT,RDTUTX		;SAVE RETURN ADDRESS
REPEAT NTUTBL-1,[
	JSP TT,RD
	ADDI UNIT,2000
	AOS BLOK
]
RDTUTX:	MOVEI TT,.
]
	JRST RD

NXTBW3:	0
	IBP DIRPT 		;DO AN IDPB T,DIRPT CHECKING TO SEE IF
	LDB DIFF,[1200,,DIRPT]	;RUNNING INTO NAME AREA
	CAML DIFF,DIR+UDNAMP
	 JSR EDIR,ERROR
	DPB T,DIRPT
	JRST @NXTBW3

NXTBW:	MOVE BLOK,LBLOCK	;FIND NEXT FREE BLOCK TO WRITE
	MOVEI HEAD,1(BLOK)
	ILDB T,TUTPT
	JUMPN T,NXTBW1		;JUMP IF VERY NEXT BLOCK NOT FREE
	AOSG T,BLKCNT
NXTBW5:	 SOJA HEAD,NXTBW4	;GENERATE LOAD ADR IF FIRST TIME (COMPENSATE FOR LBLOCK OFF BY 1)
	CAIG T,UDTKMX-1
	 JRST NXTBW2 		;NO NEED TO MODIFY DIRECTORY YET
	CLEARM BLKCNT 		;14 IN A ROW--RESET COUNTER AND
NXTBW6:	JSR NXTBW3 		;DPB BYTE INTO DIRECTORY
NXTBW2:	MOVE BLOK,HEAD
	CAML BLOK,TUT+QLASTB
	 JSR EDSK,ERROR		;NO MORE DISK LEFT
	MOVEI T,1
	DPB T,TUTPT 		;MARK BLOCK USED IN TUT
	JRST WRDB1

NXTBW1:	ADDI HEAD,1 		;SEARCH FOR NEXT FREE BLOCK
	ILDB T,TUTPT
	JUMPN T,NXTBW1
	SUBM HEAD,BLOK
	SKIPLE T,BLKCNT		;COME UP WITH DESC BYTE FOR LAST FEW BLOCKS
	 JSR NXTBW3
	CLEARM BLKCNT
	JUMPL T,NXTBW5		;FIRST TIME
	MOVEI T,UDTKMX-1(BLOK)
	CAIGE T,UDWPH 		;CAN WE SAY SKIP N--TAKE 1?
	 JRST NXTBW6 		;YES
NXTBW4:	MOVEI BLOK,NXLBYT
	MOVE T,HEAD
	ROT T,-NXLBYT*6
	ADDI T,UDWPH+1
	JSR NXTBW3
	ROT T,6
	SOJG BLOK,.-2
	JRST NXTBW6

NXTBLK:	JUMPL WRITE,NXTBW	;GET NEXT BLOCK OF FILE--IF DUMP, FIND FREE
	MOVE BLOK,LBLOCK	;BLOCK
NXTB6:	SOSLE BLKCNT 		;HAVE WE RUN OUT OF "TAKE N"?
	 AOJA BLOK,WRDB1	;NO--TAKE NEXT BLOCK
	ILDB T,DIRPT 		;YES--GET NEXT DESC BYTE
	CAILE T,UDWPH
	 JRST NXTB1 		;IT'S A LOAD ADDR
	CAIE T,UDWPH
	 JUMPN T,NXTB2 		;IT'S A TAKE OR SKIP
	CAIE CMD,'D 		;IT'S 0 OR NULL--IF THIS IS A LOAD, IT'S AN
	CAIN CMD,'K 		;UNEXPECTED END OF FILE
	 JRST KILL1 		;IF DUMP OR KILL, O.K.
	JSR EEOF,ERROR

NXTB1:	MOVEI BLOK,-UDWPH-1(T)  ;LOAD ADR
	MOVEI BUFP,NXLBYTS
NXTB1A:	MOVEI T,0
	CAIE CMD,'D
	CAIN CMD,'K
	 DPB T,DIRPT 		;IF KILLING FILE, ZERO THIS BYTE (OTHERS ZEROED AT KILL)
	LSH BLOK,6
	ILDB T,DIRPT
	ADD BLOK,T 		;GET COMPLETE BLOCK NUMBER
	SOJG BUFP,NXTB1A
	JRST NXTB3

NXTB2:	MOVEM T,BLKCNT
	CAIG T,UDTKMX
	 AOJA BLOK,WRDB1	;TAKE N STARTING WITH NEXT ONE
	ADDI BLOK,-UDTKMX+1(T)	;SKIP N-<MAX TAKE> AND TAKE 1
NXTB3:	CLEARM BLKCNT
WRDB1:	MOVEM BLOK,LBLOCK
	JRST (TT)
;RP10 IO ROUTINE
RP,[
WRDM:	SKIPL WRITE 		;SEE WHETHER LOAD OR DUMP/VERIFY
RDM:	 TRZA WRITE,(WRITE)	;READ FROM MASTER UNIT
WRM:	  HRRI WRITE,10		;WRITE ON MASTER UNIT
MU:	IORI WRITE,0 		;MASTER UNIT SELECT STORED HERE
	JRST WRD3A

WRDB:	MOVEI UNIT,DBUF		;READ OR WRITE DBUF FROM/ON CURRENT UNIT
WRD:	SKIPL WRITE		;READ OR WRITE FROM/ON CURRENT UNIT
RD:	 TRZA WRITE,(WRITE)	;READ FROM CURRENT UNIT
WR:	  HRRI WRITE,10		;WRITE ON CURRENT UNIT
CU:	IORI WRITE,0		;CURRENT UNIT SELECT STORED HERE
WRD3A:
WRD3:	DPB WRITE,[360600,,DBLK]	;SET OP, UNIT SEL
	DPB WRITE,[DUNFLD SEEK]
	DPB WRITE,[DUNFLD RECAL]
	HRLI UNIT,-2000		;ADDRESS COMES IN IN `UNIT'
	MOVEM UNIT,@ICWA
	SOS @ICWA
	LDB UNIT,[300,,WRITE]	;ISOLATE FROM GARBAGE
	MOVNI DIFF,16.		;INITIALIZE ERROR COUNTER
	MOVEM DIFF,ERRCT	;15. LOSSES PERMITTED
WRD5:	HRRZ DIFF,BLOK
	IMULI DIFF,SECBLK
	IDIVI DIFF,NSECS
	DPB HEAD,[DSECT DBLK]
	IDIVI DIFF,NHEDS
	DPB HEAD,[DSURF DBLK]
	DPB DIFF,[DCYL DBLK]
	DPB DIFF,[DCYL SEEK]
	DATAO DPC,CLATT		;CLEAR ATTENTIONS
	LSH DIFF,-8		;EXTRA CYLINDER BIT FOR RP03
	DPB DIFF,[DCYLXB DBLK]
	DPB DIFF,[DCYLXB SEEK]
	DATAO DPC,SEEK
	DATAI DPC,DIFF
	TRNN DIFF,ALLATT
	 JRST .-2
	DATAO DPC,CLATT
	TLNN DIFF,(ONCYL)
	 JRST WRD0
	DATAO DPC,DBLK
	CONSO DPC,DONE
	 JRST .-1
	CONSO DPC,ALLER
	 JRST WRDX
	HRRZM BLOK,BADBLK
	AOSG ERRCT		;HARDWARE ERROR--CHECK COUNTER
	 JRST WRD5		;TRY AGAIN
	TRNE WRITE,10		;GIVE UP--DISTINGUISH BETWEEN
	 JSR ECWR,ERROR		;WRITE ERRORS AND
	JSR ECRD,ERROR		;READ ERRORS

WRDX:	HRRZ UNIT,@ICWA		;RESTORE ADDR
	ADDI UNIT,1 		;COMPENSATE FOR IOWD LOSSAGE
	TRZ WRITE,-1		;FLUSH GARBAGE
	JRST (TT)

WRD0:	AOSLE ERRCT
	 JSR EC63,ERROR
	DATAO DPC,RECAL
	DATAI DPC,DIFF
	TRNN DIFF,ALLATT
	 JRST .-2
	JRST WRD5

DBLK:	ICWA
SEEK:	DSEEKC
RECAL:	DRCALC
CLATT:	DEASEC ALLATT
];RP
;RH11 IO ROUTINE
PH,[
WRDM:	SKIPL WRITE 		;SEE WHETHER LOAD OR DUMP/VERIFY
RDM:	 TRZA WRITE,(WRITE)	;READ FROM MASTER UNIT
WRM:	  HRRI WRITE,10		;WRITE ON MASTER UNIT
MU:	IORI WRITE,0 		;MASTER UNIT SELECT STORED HERE
	JRST WRD3A

WRDB:	MOVEI UNIT,DBUF		;READ OR WRITE DBUF FROM/ON CURRENT UNIT
WRD:	SKIPL WRITE		;READ OR WRITE FROM/ON CURRENT UNIT
RD:	 TRZA WRITE,(WRITE)	;READ FROM CURRENT UNIT
WR:	  HRRI WRITE,10		;WRITE ON CURRENT UNIT
CU:	IORI WRITE,0		;CURRENT UNIT SELECT STORED HERE
WRD3A:
WRD3:	TRNE UNIT,1777		; Better be on a page boundary!
	 JRST 4,.
	LDB DIFF,[111100,,UNIT]	; Point Unibus map at page in question
	TRO DIFF,%UQFST+%UQVAL
	IOWRQ DIFF,UBAPAG+UBPG_1
	ADDI DIFF,1
	IOWRQ DIFF,UBAPAG+UBPG_1+1
	LDB DIFF,[000300,,WRITE]	; Select drive
	IOWRQ DIFF,%HRCS2
	JSP HEAD,RHCHEK		; Check for immediate trouble
	MOVEI DIFF,%HMRDP	; Init the drive
	IOWRQ DIFF,%HRCS1
	MOVNI DIFF,16.		;INITIALIZE ERROR COUNTER
	MOVEM DIFF,ERRCT	;15. LOSSES PERMITTED
WRD5:	MOVNI DIFF,4000
	IOWRQ DIFF,%HRWC	; 4000 half words
	MOVEI DIFF,UBPG_14
	IOWRQ DIFF,%HRBA	; "Byte" base address
	HRRZ DIFF,BLOK
	IDIVI DIFF,NBLKSC
	IOWRQ DIFF,%HRCYL	; Desire cylinder
	MOVE DIFF,HEAD
	IMULI DIFF,SECBLK
	IDIVI DIFF,NSECS
	DPB DIFF,[$HATRK HEAD]
	IOWRQ HEAD,%HRADR	; Desire track and sector
	MOVEI DIFF,%HMRED
	TRNE WRITE,10
	 MOVEI DIFF,%HMWRT
	IOWRQ DIFF,%HRCS1	; Do it (implied seek)
WRD7:	IORDQ DIFF,%HRCS1
	TRNN DIFF,%HXRDY	; Wait for controller to finish
	 JRST WRD7
	TRNN DIFF,%HXTRE+%HXMCP	; Trouble?
	 JRST WRDX		; Nope, exit
	HRRZM BLOK,BADBLK
	AOSG ERRCT		;HARDWARE ERROR--CHECK COUNTER
	 JRST WRD0		;RECALIBRATE AND TRY AGAIN
	TRNE WRITE,10		;GIVE UP--DISTINGUISH BETWEEN
	 JSR ECWR,ERROR		;WRITE ERRORS AND
	JSR ECRD,ERROR		;READ ERRORS

WRDX:	TRZ WRITE,-1		;FLUSH GARBAGE
	JRST (TT)

WRD0:	MOVEI DIFF,%HYCLR	; Clear controller
	IOWRQ DIFF,%HRCS2
	LDB DIFF,[000300,,WRITE]	; Select drive
	IOWRQ DIFF,%HRCS2
	MOVEI DIFF,%HMCLR	; Clear drive
	IOWRQ DIFF,%HRCS1
	JSP HEAD,RHCHEK		; Immediate lossage?
	MOVEI DIFF,%HMREC	; Recalibrate
	IOWRQ DIFF,%HRCS1
	MOVEI HEAD,100000.
WRD0A:	SOSGE HEAD
	 JSR EC63,ERROR
	IORDQ DIFF,%HRSTS
	TRNE DIFF,%HSPIP	; WAIT FOR DRIVE TO FINISH
	 JRST WRD0A
	ANDI DIFF,%HSDPR+%HSMOL+%HSVV+%HSRDY+%HSERR
	CAIE DIFF,%HSDPR+%HSMOL+%HSVV+%HSRDY
	 JSR EDLZ,ERROR
	JRST WRD5

;;; JSP HEAD,RHCHEK to check for errors.
RHCHEK:	IORDQ DIFF,%HRCS1
	TRNE DIFF,%HXTRE+%HXMCP
	 JSR EDLZ,ERROR
	JRST (HEAD)
];PH
;RH10 IO ROUTINE
RH,[
WRDM:	SKIPL WRITE 		;SEE WHETHER LOAD OR DUMP/VERIFY
RDM:	 TRZA WRITE,(WRITE)	;READ FROM MASTER UNIT
WRM:	  HRRI WRITE,10		;WRITE ON MASTER UNIT
MU:	IORI WRITE,0 		;MASTER UNIT SELECT STORED HERE
	JRST WRD3A

WRDB:	MOVEI UNIT,DBUF		;READ OR WRITE DBUF FROM/ON CURRENT UNIT
WRD:	SKIPL WRITE		;READ OR WRITE FROM/ON CURRENT UNIT
RD:	 TRZA WRITE,(WRITE)	;READ FROM CURRENT UNIT
WR:	  HRRI WRITE,10		;WRITE ON CURRENT UNIT
CU:	IORI WRITE,0		;CURRENT UNIT SELECT STORED HERE
WRD3A:
WRD3:	HRLI UNIT,-2000		;ADDRESS COMES IN IN `UNIT'
	CONI DSK,HEAD		;SET WORD COUNT TO ONE BLOCK
	TLNE HEAD,(%HID22)	;ACCORDING TO TYPE OF CHANNEL
	 HRLI UNIT,-2000_4
	MOVEM UNIT,@ICWA
	LDB UNIT,[300,,WRITE]	;ISOLATE FROM GARBAGE
	SOS @ICWA		;ADJUST FOR DF10 LOSSAGE
	MOVNI DIFF,16.		;INITIALIZE ERROR COUNTER
	MOVEM DIFF,ERRCT	;15. LOSSES PERMITTED
WRD5:	MOVSI DIFF,%HRDCL(UNIT)
	HRRI DIFF,%HMRDP	;INIT THE DRIVE
	JSP HEAD,RHSET
	HRRZ DIFF,BLOK
	IDIVI DIFF,NBLKSC
	EXCH DIFF,HEAD
	MOVEM HEAD,DBLK		;SAVE CYLINDER
	IMULI DIFF,SECBLK
	IDIVI DIFF,NSECS
	EXCH DIFF,HEAD
	DPB HEAD,[$HATRK DIFF]
	TLO DIFF,%HRADR(UNIT)
	JSP HEAD,RHSET
	MOVE DIFF,DBLK
	TLO DIFF,%HRCYL(UNIT)
	JSP HEAD,RHSET
	MOVSI DIFF,%HRCTL(UNIT)
	IORI DIFF,ICWA_6
	TRNE WRITE,10
	 TROA DIFF,%HMWRT
	  TRO DIFF,%HMRED
	JSP HEAD,RHSET		;DO IT (USE IMPLIED SEEK)
	CONSO DSK,%HIDON
	 JRST .-1
	CONSO DSK,%HIERR
	 JRST WRDX
	HRRZM BLOK,BADBLK
	AOSG ERRCT		;HARDWARE ERROR--CHECK COUNTER
	 JRST WRD0		;RECALIBRATE AND TRY AGAIN
	TRNE WRITE,10		;GIVE UP--DISTINGUISH BETWEEN
	 JSR ECWR,ERROR		;WRITE ERRORS AND
	JSR ECRD,ERROR		;READ ERRORS

WRDX:	HRRZ UNIT,@ICWA		;RESTORE ADDR
	ADDI UNIT,1 		;COMPENSATE FOR IOWD LOSSAGE
	TRZ WRITE,-1		;FLUSH GARBAGE
	JRST (TT)

WRD0:	MOVSI DIFF,%HRDCL(UNIT)
	HRRI DIFF,%HMCLR
	JSP HEAD,RHSET
	MOVSI DIFF,%HRDCL(UNIT)
	HRRI DIFF,%HMREC
	JSP HEAD,RHSET
	MOVEI DIFF,100000.
	MOVEM DIFF,DBLK
WRD0A:	SOSGE DBLK
	 JSR EC63,ERROR
	MOVSI DIFF,%HRSTS(UNIT)
	JSP HEAD,RHGET
	TRNE DIFF,%HSPIP
	 JRST WRD0A
	ANDI DIFF,%HSVV+%HSRDY+%HSMOL+%HSERR
	CAIE DIFF,%HSVV+%HSRDY+%HSMOL
	 JSR EDLZ,ERROR
	JRST WRD5

;RH10 HACKING ROUTINES. CALL BY JSP HEAD,.  DIFF HAS REGISTER ADDRESS IN LH, DATA IN RH.
RHSET:	TLOA DIFF,%HRLOD
RHGET:	 TLZ DIFF,%HRLOD
	DATAO DSK,DIFF
	MOVEI DIFF,20
	SOJG DIFF,.
	DATAI DSK,DIFF
	TLNE DIFF,%HDERR
	 JSR EDLZ,ERROR
	ANDI DIFF,177777
	JRST (HEAD)

DBLK:	0
];RH
;SC DISK IO ROUTINE
SC,[
WRDM:	SKIPL WRITE 		;SEE WHETHER LOAD OR DUMP/VERIFY
RDM:	 TRZA WRITE,(WRITE)	;READ FROM MASTER UNIT
WRM:	  HRRI WRITE,60#120	;WRITE ON MASTER UNIT
MU:	IORI WRITE,0 		;MASTER UNIT SELECT STORED HERE
	JRST WRD3A

WRDB:	MOVEI UNIT,DBUF		;READ OR WRITE DBUF FROM/ON CURRENT UNIT
WRD:	SKIPL WRITE		;READ OR WRITE FROM/ON CURRENT UNIT
RD:	 TRZA WRITE,(WRITE)	;READ FROM CURRENT UNIT
WR:	  HRRI WRITE,60#120	;WRITE ON CURRENT UNIT
CU:	IORI WRITE,0		;CURRENT UNIT SELECT STORED HERE
WRD3A:	TRC WRITE,120
WRD3:	DPB WRITE,[330700,,DBLK]	;SET OP, UNIT SEL
	DPB UNIT,[DCCA DBLK+1]	; & CORE ADDR
	DPB UNIT,[DCCA DBLK1+1]
	LDB UNIT,[400,,WRITE]	;ISOLATE FROM GARBAGE
	MOVNI DIFF,16.		;INITIALIZE ERROR COUNTER
	MOVEM DIFF,ERRCT	;15. LOSSES PERMITTED
WRD5:	HRRZ DIFF,BLOK
	IDIVI DIFF,NSECS
	DPB HEAD,[DSECT DBLK]
	IDIVI DIFF,NHEDS
	DPB HEAD,[DSURF DBLK]
	DPB DIFF,[DCYL DBLK]
	CONO DC0,DCCSET\DCDENB	;RESET ALL, THEN SET DCDENB
	CAIL DIFF,NCYLS
	 TDZA DIFF,DIFF
	  SKIPLE DIFF,PKNUM(UNIT)
	   JRST WRD4		;PKID IN
	MOVE DIFF,QTRAN(UNIT)	;READ PACK ID
	DPB DIFF,[DUNFLD GPKID]
	MOVEI DIFF,TUTCYL
	SKIPGE QTRAN(UNIT)
	 ADDI DIFF,NCYLS+XCYLS
	DPB DIFF,[DCYL GPKID]
	DATAO DC0,[DJMP GPKID]
	CONSZ DC0,DSSACT
	 JRST .-1
	CONSZ DC0,DSSERR
	 JRST WRD0
	CONO DC0,DCCSET\DCDENB	;RESET POSSIBLE "FUTURE" IP OR RLCERR
	LDB DIFF,[DPKID RPKID]
	MOVEM DIFF,PKNUM(UNIT)
WRD4:	DPB DIFF,[DPKID DBLK]
	MOVE DIFF,DBLK
	DPB DIFF,[3300,,DBLK1]
	MOVE DIFF,QTRAN(UNIT)
	DPB DIFF,[DUNFLD DBLK]
	JUMPGE DIFF,WRD4A
	LDB DIFF,[DCYL DBLK]	;2ND HALF UNIT
	ADDI DIFF,NCYLS+XCYLS
	DPB DIFF,[DCYL DBLK]
WRD4A:	DATAO DC0,[DJMP DBLK]
	CONSZ DC0,DSSACT
	 JRST .-1
	CONSO DC0,DSSERR
	 JRST WRDX	;XFER OK
	MOVE DIFF,ERRCT
	TRNN DIFF,2	;DO RECALIBRATE 2 OUT OF 4 RETRIES
	 JRST WRD2
WRD0:	AOSLE ERRCT	;POSITIONER ERROR--CHECK ERROR COUNT
	 JSR EC63,ERROR	;TOO MANY--GIVE UP
	DATAO DC0,[DSPC+DSRCAL+DSWINF]
	CONSO DC0,DSSATT
	 JRST .-1
	JRST WRD5	;TRY AGAIN AFTER RESETTING UNIT

WRD2:	HRRZM BLOK,BADBLK
	AOSG ERRCT	;HARDWARE ERROR--CHECK COUNTER
	 JRST WRD5	;TRY AGAIN
	TRNE WRITE,40	;GIVE UP--DISTINGUISH BETWEEN
	 JSR ECWR,ERROR	;WRITE ERRORS AND
	JSR ECRD,ERROR	;READ ERRORS

WRDX:	DPB BLOK,[XWBLK XWDS]	;PNTR TO PREV BLOCK
	LDB UNIT,[DCCA DBLK+1]	;RESTORE ADR
	TRZ WRITE,-1	;FLUSH GARBAGE
	JRST (TT)

DBLK:	DREAD+DUNENB
	DCOPY .(-2000_2&37774)
	DCOPY XWDS(-4_2&37774)
DBLK1:	DRC
	DCOPY .(-2000_2&37774)
	DCOPY XWDS(-4_2&37774)
	DHLT

GPKID:	DSPC+DSCRHD+DSWIDX+DSWNUL+DUNENB+TUTCYL_11.+TUTSRF_6+TUTSEC
	DCOPY RPKID(37774)
	DHLT
];SC

;JSP P,TYI RETURNS CHAR IN C.
;JSP P,TYI0 ALSO SKIPS IF NO INPUT AVAILABLE.
TYI:	ILDB C,MEMSIZ-1		;CHECK FOR COMMANDS FROM MEMORY
	JUMPN C,(P)		;FOUND ONE--RETURN
	CLEARM MEMSIZ-1
TYI0:				;ENTRY TO SKIP IF NO INPUT AVAILABLE
KA,[	CONSO TTY,40
	 JRST TYI1
	DATAI TTY,C
]
KS,[	SKIPN C,8CTYIN
	 JRST TYI1
	ANDI C,177
	SETZM 8CTYIN
]
KL,[	MOVEI C,3400		;DDT MODE INPUT
	SETZM DTEFLG
	MOVEM C,DTECMD
	CONO DTE,%DBL11
	SKIPN DTEFLG
	 JRST .-1
	MOVE C,DTEF11
	SETZM DTEFLG
	JUMPE C,TYI1
]	ANDI C,177
	CAIGE C,175
	CAIN C,33
	 JRST (P)		;DON'T ECHO GRITCHES
;DROP INTO TYO

;JSP P,TYO TYPES OUT CHAR IN C.  CLOBBERS A,C.
TYO:	;SKIPE MEMSIZ-1
	; JRST (P)		;DON'T ECHO COMMANDS FROM MEMORY
KA,[	HRRZ A,C		;COMPUTE PARITY
	IMULI A,40201
	AND A,[1111111]
	IMUL A,[1111111]
	TLNE A,1
	 IORI C,200
	CONSZ TTY,20
	 JRST .-1
	DATAO TTY,C
	ANDCMI C,200
]
KS,[	MOVE A,C
	ANDI A,177
	TRO A,400
	MOVEM A,8CTYOT
	CONI A
	IORI A,80INT
	CONO (A)
	SKIPE 8CTYOT
	 JRST .-1
]
KL,[	MOVE A,C
	ANDI A,177
	SETZM DTEFLG
	MOVEM A,DTECMD
	CONO DTE,%DBL11
	SKIPN DTEFLG
	 JRST .-1
	SETZM DTEFLG
]
	JUMPGE C,(P)		;CHECK FOR CRLF (AS OPPOSED TO ECHOING A CR)
	SKIPA C,C12		;TYPE AN LF
CRLF:	 HRROI C,15
	JRST TYO

TYI1:	HRRZ C,-1(P)		;NO INPUT AVAILABLE
	CAIE C,TYI0
	 JRST TYI		;WAIT FOR IT
	JRST 1(P)		;CALL WAS TO TYI0, SKIP RETURN

LINK:	CAIE CMD,'D
	CAIN CMD,'K
	 MOVSI WRITE,-1		;MAKE THIS INFO MORE CONVENIENT
	MOVE D,[440600,,C]
	MOVEI T,0
LINKL:	ILDB TT,DIRPT
	SKIPGE WRITE
	 DPB T,DIRPT		;CLOBBER CHARS READ FOR DUMP OR KILL
	CAIN TT,';
	 JRST LINKN
	CAIN TT,':
	 JRST LINKQ
	JUMPE TT,LINKN
LINKQ1:	IDPB TT,D
	TLNE D,770000
	 JRST LINKL
LINKN1:	CAMGE D,[600,,B]	;THROUGH WITH FN2?
	 JRST LINKL
	JUMPL WRITE,KILL1
	MOVEM A,FN1
	MOVEM B,FN2
	JRST MLOOK2

LINKN:	TLNN D,770000
	 JRST LINKN1
	IDPB T,D		;FILL OUT WITH SPACES
	JRST LINKN

LINKQ:	ILDB TT,DIRPT
	JUMPGE WRITE,LINKQ1
	DPB T,DIRPT
	JRST LINKQ1

READ:	MOVEI BLKIN,CORE
	JSP P,CRLF
	MOVEI CMD,0		;INITIALIZE COMMAND
READ1A:	MOVEI WRITE,0		;INITIALIZE NUMBER
	MOVSI B,(SIXBIT \@\)	;INITIALIZE 1ST FILE NAME
READ1:	MOVEM B,FN1
READ3A:	MOVSI B,(SIXBIT \@\)	;INITIALIZE CURRENT FILE NAME
	MOVE D,[440600,,B]
READ2:	JSP P,TYI
	CAIN C,177
	 JRST READ		;IF RUBOUT START OVER
	CAIGE C,175
	CAIN C,33
	 JRST ALTMOD		;JUMP IF 33, 175, 176
	ASH WRITE,3		;DOES NOT CHANGE SIGN OF WRITE
	CAIL C,"0
	CAILE C,"7
	 TLOA WRITE,400000	;NON-NUMERIC CHAR--MAKE WRITE NEGATIVE
	  ADDI WRITE,-"0(C)	;NUMERIC CHAR--ACCUMULATE NUMBER
	CAIN C,";
	 JRST READ3		;SET SYSTEM NAME
	CAIN C,40
	 JRST READ1		;SET FIRST FILE NAME
	CAIN C,^Q
	 JSP P,TYI		;QUOTED CHARACTER
	CAIGE C,140		;CHECK FOR LOWER CASE
	 SUBI C,40
	JUMPL C,DOIT		;IF LESS THAN 40 (EXC. ^Q) END OF COMMAND
	TLNE D,770000		;SKIP IF ALREADY SIX CHARS
	 IDPB C,D
	JRST READ2

READ3:	MOVEM B,SYSN
	CAIE CMD,'U
	 JRST READ3A
	JRST DOIT		;IF COMMAND IS U GO LIST DIRECTORY

ONOFF:	CAIGE WRITE,NDSK
	 DPB CMD,[100,,QDED(WRITE)]	;LOW BIT OF CMD DETERMINES ON/OFF LINE STATUS
	JRST READ  		; (K=13, L=14)

ALT1:	LDB CMD,D		;PICK UP COMMAND CHAR
	CAIE CMD,'K
	 TRNN CMD,2
	  JRST READ1A		;GET FILE NAME
	JRST DOIT		;DON'T WANT FILE NAME--GO TO WORK

ALTMOD:	MOVEI C,"$
	JSP P,TYO		;ECHO DOLLAR SIGN
	JUMPLE WRITE,ALT2	;JUMP IF NOT <NUMBER><ALTMODE> LAST TYPED
	JUMPN CMD,ONOFF		;JUMP IF <CMD><ALTMODE><NUMBER><ALTMODE>
	HRRM WRITE,SADR		;SET STARTING ADDR
	JRST READ

ALT2:	TLC D,360000
	TLCN D,360000		;SKIP IF SINGLE CHARACTER BEFORE <ALTMODE>
	 JUMPE CMD,ALT1		;JUMP IF NO COMMAND ALREADY TYPED
DOIT:	MOVEM B,FN2		;STORE SECOND FILE NAME
	HRRZ B,MU
	HRRM B,CU		;MAKE MASTER UNIT CURRENT UNIT
	MOVNI WRITE,1
	JSP P,LODUMP		;DUMP OUT PSEUDO-CORE
	CAIN CMD,'G
	 JRST LOADG0		;GO
	JSP TT,RDTUT
	MOVE C,SYSN
MLOOK2:	MOVSI WRITE,1		;MAKE WRITE INDICATE LOAD
	MOVEI BLOK,MFDBLK
	MOVEI UNIT,DIR
	JSP TT,RD		;READ MASTER DIRECTORY TO FIND WHERE USER DIRECTORY IS
	MOVE T,DIR+MDCHK
	CAME T,[SIXBIT/M.F.D./]
	 JSR EMFC,ERROR
	MOVE T,DIR+MDNUDS
	CAIE T,NUDSL
	 JSR EMFC,ERROR
	CAIN CMD,'S
	 JRST LISTS		;LIST DISK ID'S AND SYSTEM NAMES
	MOVE T,DIR+MDNAMP
MLOOK:	CAMN C,DIR+MNUNAM(T)	;LOOK UP SYSTEM NAME
	 JRST MLOOK1
	ADDI T,LMNBLK
	CAIGE T,2000
	 JRST MLOOK
	JSR ESNF,ERROR		;NOT FOUND

MLOOK1:	MOVEI BLOK,2*NUDSL-2000(T)	;CONVERT USER SLOT TO BLOCK NUMBER
	LSH BLOK,-1
	HRRM BLOK,UDBLK		;REMEMBER FOR KILL OR DUMP
	MOVEI UNIT,DIR
	JSP TT,RDM		;READ USER DIRECTORY
ULOOK:	CAME C,DIR+UDNAME
	 JSR ECDR,ERROR		;WRONG ONE??
	CAIE CMD,'F
	CAIN CMD,'U
	 JRST LISTFC		;LIST USER DIRECTORY
	MOVSI TT,UNIGFL
	MOVE T,DIR+UDNAMP
	MOVE A,FN1
	MOVE B,FN2
ULOOK1:	CAMN A,DIR+UNFN1(T)	;LOOK UP FILE NAME
	CAME B,DIR+UNFN2(T)
	 JRST ULOOK2
	TDNN TT,DIR+UNRNDM(T)	;IS THIS FILE FOR REAL?
	 JRST ULOOK3
ULOOK2:	ADDI T,LUNBLK
	CAIGE T,2000
	 JRST ULOOK1
	CAIE CMD,'D		;IF NOT FOUND BETTER BE DUMP
	 JSR EFNF,ERROR
	MOVE T,DIR+UDNAMP
ULOOK4:	SKIPN DIR+UNFN1(T)	;FIND FREE SLOT FOR NEW FILE
	 JRST DUMP
	ADDI T,LUNBLK
	CAIGE T,2000
	 JRST ULOOK4
	MOVNI T,LUNBLK		;NO FREE SLOTS--TRY TO EXTEND NAME AREA DOWN
	ADDM T,DIR+UDNAMP
	MOVE T,DIR+UDESCP
	IDIVI T,6
	ADDI T,UDDESC
	CAMGE T,DIR+UDNAMP	;DID WE RUN INTO DESCRIPTOR AREA?
	 JRST DUMP0
	JSR EDIR,ERROR		;YES

ULOOK3:	HRRM T,DMP4		;IF FILE FOUND, SAVE SLOT NUMBER FOR DUMP
	LDB C,[UNDSCP DIR+UNRNDM(T)]
	JSP TT,GBP
	MOVEM C,DIRPT		;SET UP DESCRIPTOR AREA BYTE POINTER
	MOVSI TT,UNLINK
	TDNE TT,DIR+UNRNDM(T)
	 JRST LINK		;FILE IS A LINK
	LDB A,[UNPKN DIR+UNRNDM(T)]
ULOOK5:	CAMN A,TUT+QPKNUM	;SEE IF IT'S MOUNTED
	 JRST LOAD
	JSP TT,NXTTUT
	 JRST ULOOK5
	JSR EPNM,ERROR

LOAD:	CAIE CMD,'D		;GET HERE IF FILE FOUND
	CAIN CMD,'K		;IF DUMP OR KILL, DELETE IT
	 JRST KILL
ZERO:	MOVEI TT,CORE-1
	TRNN CMD,20		;SKIP IF T$ SYMBOL LOADING COMMAND
	 JRST ZERO1
	MOVEI B,DDT-1		;ASSUME ALWAYS USING MOBY DDT
	JSP P,FD		;GET DDT'S SYMBOL TABLE POINTER
	 JSR EDDT,ERROR		;CAN'T GET IT??
	HRROS B,(C)		;TELL DDT ITS SYMBOL TABLE WAS BUGGERED
	CAME B,[-1,,DDT-2]	;VERIFY THAT IT'S REALLY A MOBY DDT LIKE WE THOUGHT
	 JSR EDDT,ERROR
	SKIPE D,-2(C)		;FLUSH ALL BUT INITIAL SYMBOLS
	 MOVEM D,-1(C)
	MOVE D,-1(C)
	MOVEI TT,CORE-1
	CAILE TT,-1(D)
	 MOVEI TT,-1(D)		;DON'T ZERO SYMBOL TABLE NOR DDT
ZERO1:	TRNE CMD,1
	 JRST LOAD1		;NON-ZEROING COMMAND
	SETZM 40 		;BEGIN CLEARING CORE
	MOVE T,[40,,41]		;SET UP BLT POINTER
;CODE TO SKIP OVER NXM
ZERO2:	CAIG TT,10*2000-1(T)	;MORE THAN 8K LEFT TO ZERO?
	 JRST ZERO4 		;NO, ZERO REMAINING WORDS AND PROCEED
	MOVE D,T		;AVOID KA/KL INCOMPAT BY COPYING BLT PNTR
	BLT D,10*2000-1(T)	;ZERO NEXT 8K
ZERO3:	ADDI T,10*2000		;MOVE DEST OF BLT PNTR UP 8K
	ANDCMI T,1777 		;ROUND DOWN TO 1K BOUNDARY
KA,	CONO 10000 		;CLEAR NXM
	MOVES (T) 		;SET NXM IF HOLE
KA,	CONSZ 10000 		;NXM GENERATED?
KA,	 JRST ZERO3 		;YES, GO TO NEXT 8K
	JRST ZERO2 		;NO, CLEAR THIS 8K

ZERO4:	BLT T,(TT) 		;AND CLEAR TO TOP BOUNDARY
	TRNE CMD,20
	 JRST LOAD1		;IF SYMBOL-LOADING COMMAND, STOP THERE
	CLEARM CBUF
	MOVE T,[CBUF,,CBUF+1]
	BLT T,CBUF+1777
	MOVEI UNIT,CBUF
	MOVE BLOK,CBLK		;-NSWBL IN LH
	JSP TT,WRM		;CLEAR PSEUDO-CORE
	AOBJN BLOK,.-1
LOAD1:	SETZB BUFP,BLKCNT	;SET UP BUFP SO FIRST CALL TO WD WILL READ
LOAD2:	JSP P,WD		;FIRST BLOCK OF FILE
	CAME D,[JRST 1]		;LOOK FOR END OF SBLK LOADER
	 JRST LOAD2
	CAIN CMD,'I		;IF VERIFY, START SIMULATING DUMP
	 JRST DUMP.5
LOAD3:	JSP P,WD		;READ BLOCK HEADER
	JUMPGE D,LOADS		;IT'S A JUMP BLOCK
	MOVE A,D
	MOVE B,D
	JSR LOADB		;LOAD LOGICAL BLOCK INTO CORE
	JRST LOAD3

LOADB:	0
LOAD4:	JSP P,WD		;LOAD A LOGICAL BLOCK--AOBJN POINTER IN B,
	ROT A,1			;BLOCK HEADER IN A (FOR CHECKSUM)
	ADD A,D			;ADD NEW WORD INTO CHECKSUM
	JSP P,FD		;AND PREPARE TO SMASH IT AWAY
	 JRST .+2		;LOCATION CAN'T BE LOADED
	  MOVEM D,(C)		;SMASH WORD AWAY
	AOBJN B,LOAD4
	JSP P,WD
	CAMN A,D		;CHECK THE CHECKSUM
	 JRST @LOADB
	JSR ECKS,ERROR		;BAD CHECKSUM

LOADS:	CAIN CMD,'M
	 JRST LOADG0		;DON'T LOAD SYMBOLS NOR SADR
	MOVEM D,NXTBW3		;SAVE S.A.
	MOVEI B,DDT-1		;ASSUME IS ALWAYS MOBY DDT.
	JSP P,FD		;GET DDT'S SYMBOL TABLE POINTER
	 JSR EDDT,ERROR		;CAN'T GET IT??
	SKIPN (C)
	 JRST LOADJ		;AIN'T GOT NO DDT, IGNORE SYMBOLS	 
	HRROS B,(C)		;TELL DDT ITS SYMBOL TABLE WAS BUGGERED
	CAMN B,[-1,,DDT-2]	;VERIFY THAT IT'S REALLY A MOBY DDT LIKE WE THOUGHT
	 JSP P,FD		;FETCH SYMBOL TABLE POINTER
	  JSR EDDT,ERROR
	MOVE D,(C)
	MOVEM D,DDTM2
LOADS1:	MOVE B,DDTM2		;GET LOWEST SYMBOL LOC SO FAR
	JSP P,WD		;GET SYMBOL BLOCK HEADER
	JUMPGE D,LOADS2		;JUMP IF END OF SYMBOLS
	TRNE D,-1		;SKIP IF REALLY SYMBOLS AND NOT SOME OTHER BRAIN-DAMAGED CRUFT
	 JRST LOADBD
	MOVSS D
	HRLI D,-1(D)
	ADD B,D			;EFFECTIVELY SUBTRACTS LENGTH OF BLOCK FROM BOTH HALVES
	MOVEM B,DDTM2		;OF SYMBOL TABLE POINTER
	HRL B,D			;SET UP AOBJN POINTER IN B
	HRLZ A,D		;AND RECREATE HEADER IN A
	JSR LOADB		;LOAD THE SYMBOLS
	JRST LOADS1

LOADBD:	HLRO B,D		;-# WORDS TO SKIP (NOT COUNTING CHECKSUM)
	JSP P,WD
	AOJLE B,.-1
	JRST LOADS1		;TRY NEXT SYMBOL BLOCK

LOADS2:	MOVE D,DDTM2		;GET UPDATED DDT SYMBOL PNTR
LOADS4:	MOVEI B,DDT-2		;WE KNOW WHERE IT ALWAYS GOES
	JSP P,FD		;PUT BACK SYMBOL TABLE POINTER
	 JSR EBUG,ERROR		;CAN'T PUT IT BACK??
	MOVEM D,(C)
	MOVEI B,DDT-4		;GIVE STARTING ADDRESS TO DDT
	JSP P,FD
	 JSR EBUG,ERROR
	MOVE D,NXTBW3
	MOVEM D,(C)
	MOVEI D,DDT		;AND SET DSKDMP START ADDRESS TO DDT
LOADJ:	HRRM D,SADR		;SET STARTING ADDRESS FROM JUMP BLOCK
LOADG0:	MOVE T,BOOTNS		;APPROP DISK WAIT FOR NON BUSY INSTR
	MOVEM T,BOOT
LOADG:	JSP TT,WRCB		;MAKE SURE ALL LOADED CRUFT IN PSEUDO-CORE IS OUT
	MOVEI WRITE,0
	JSP P,LODUMP		;AND LOAD IT ALL IN
	TRNE CMD,10
	 JRST READ		;NON-GOING COMMAND
GO:
PH,[	MOVSI B,-LSWPADR
GO1:	IORD DIFF,SWPCS1
	TRNN DIFF,%HXRDY	; Wait for controller
	 JRST GO1
	HRRZ DIFF,SWPVAL(B)
	IOWR DIFF,SWPADR(B)
	AOBJN B,GO1
];PH
RH,[	MOVE B,ERRWD
	CONI DSK,HEAD
	TLNE HEAD,(%HID22)
	 HRLI B,-1700_4
	MOVEM B,@ICWA
	MOVSI B,-6
GO1:	CONSZ DSK,%HIBSY
	 JRST .-1
	MOVE DIFF,SWPOU1(B)
	JSP HEAD,RHSET
	AOBJN B,GO1
];RH
RP,[	MOVE B,ERRWD
	MOVEM B,@ICWA
	DATAO DPC,SWPSK
	JSP P,SKWAIT
	DATAO DPC,SWPOU1
	CONSO DPC,DONE
	 JRST .-1
	DATAO DPC,SWPOU2
];RP
SC,	DATAO DC0,[DJMP SWPOUT]
	JRST WAIT

LISTS:	JSP P,CRLF
LISTS2:	JSP P,TYI0
	 JRST LOADG1		;SHUT UP IF KEY HIT
	MOVE C,TUT+QPKNUM	;TYPE PACK NUMBER
	JSP TT,PNO
	MOVE D,TUT+QPAKID	;AND I.D.
	JSP TT,PD2
	JSP TT,NXTTUT		;SAME FOR ALL DIRECTORIES
	 JRST LISTS2
	MOVE T,DIR+MDNAMP
LISTS1: CAIGE T,2000
	 JSP P,TYI0		;STOP TYPING IF TTI FLAG ON
	  JRST LOADG1
	SKIPE D,DIR+MNUNAM(T)
	 JSP TT,PD		;TYPE OUT USER NAME
	ADDI T,LMNBLK
	JRST LISTS1

LISTFC:	MOVE T,DIR+UDNAMP
LISTF1:	
KA,	CONSO TTY,40		;STOP TYPING IF TTI FLAG ON
KS,	SKIPN 8CTYIN		; Stop typing if character waiting
	 CAIL T,2000
	  JRST LOADG1
	SKIPN DIR+UNFN1(T)	;SKIP IF FILE IN THIS SLOT
	 JRST LISTF2
	JSP P,CRLF
	LDB C,[UNPKN DIR+UNRNDM(T)]
	JSP TT,PNO		;TYPE PACK NUMBER
	MOVE D,DIR+UNFN1(T)
	JSP TT,PD2		;TYPE FIRST FILE NAME
	MOVE D,DIR+UNFN2(T)
	JSP TT,PD2		;AND SECOND FILE NAME
LISTF2:	ADDI T,LUNBLK
	JRST LISTF1

KILL:	JSP TT,NXTB6		;GET HERE ON KILL OR DUMP OF EXISTING FILE
	MOVEI T,0		;ZERO BYTES IN USER DIRECTORY DESCIPTOR AREA
	DPB T,DIRPT		;NXTB6 JUMPS TO KILL1 AT END OF FILE
	MOVE C,BLOK
	JSP TT,GTP
	ILDB T,C
	CAIGE T,TUTLK-1		;SOS USAGE OF THIS BLOCK
	 SOJL T,[JSR ECDR,ERROR]
	DPB T,C
	JRST KILL

KILL1:	HRRZ T,DMP4		;CLEAR OUT USER DIRECTORY SLOT
	CLEARM DIR+UNFN1(T)
	CLEARM DIR+UNFN2(T)
	CLEARM DIR+UNRNDM(T)
	MOVSI WRITE,-1
	CAIN CMD,'K
	 JRST KILDMP		;IF KILL DON'T DUMP
	JRST DMP4		;MUST DUMP ON SAME UNIT

DUMP0:	MOVE T,DIR+UDNAMP	;GET HERE IF SLOT CREATED AT BOTTOM OF NAME AREA
DUMP:	HRRM T,DMP4		;GET HERE IF EMPTY SLOT FOUND IN NAME AREA
DMP0:	MOVEI D,0		;GET HERE IF USING SLOT OF OLD FILE
DMP1:	;MOVE C,TUT+QSWAPA
	MOVEI C,0		;NOTE START AT 0 NOT QSWAPA
	MOVE B,C
	SUB B,TUT+QLASTB
	HRLZ B,B		;LH(B) COUNTS BLOCKS, RH(B) COUNTS FREE BLOCKS
	JSP TT,GTP
DMP2:	ILDB T,C
	SKIPE T
KA,	 SUBI B,1		;THIS RELIES ON CARRY PROPAGATING FROM RH TO LH IN AOBJN
KL,	 HRRI B,-1(B)		;ON KI10, KL10 CHANGE SUBI B,1 TO HRRI B,-1(B)
KS,	 HRRI B,-1(B)		;KS too...
	AOBJN B,DMP2
	CAIG B,(D)		;RH OF D IS HIGHEST SO FAR, LH SAYS WHICH UNIT
	 JRST DMP5		;NOT BETTER THAN RECORD
	MOVE D,B		;NEW RECORD--RECORD IT
	HRL D,CU
DMP5:	JSP TT,NXTTUT		;TRY NEXT
	 JRST DMP1
			;FALLS THROUGH AT END
DMP3:	HLRM D,CU		;SET CURRENT UNIT TO ONE WITH MOST FREE BLOCKS
	JSP TT,RDTUT		;GET ITS TUT
DMP4:	MOVEI T,.
	MOVE A,FN1
	MOVE B,FN2
	MOVEM A,DIR+UNFN1(T)	;PUT CRUFT INTO SLOT
	MOVEM B,DIR+UNFN2(T)
	SETOM DIR+UNDATE(T)	; Unknown creation date
	HRROI C,777000		; Unknown reference date
	MOVEM C,DIR+UNREF(T)	; Unknown author, 36. bit bytes
SC,[	MOVEM A,XWDS+XWFN1
	MOVEM B,XWDS+XWFN2
	MOVE C,SYSN
	MOVEM C,XWDS+XWSYSN
]	MOVE C,DIR+UDESCP	;PUT DESCRIPTOR CHARACTER ADDRESS
	MOVE B,TUT+QPKNUM	;AND PACK NUMBER
	DPB B,[UNPKN C]
	MOVEM C,DIR+UNRNDM(T)	;INTO USER DIRECTORY SLOT
	;MOVE C,TUT+QSWAPA	;COMMENTED OUT INSN DUMPS INTO FILE AREA
	MOVEI C,0		;DUMP INTO SWAPPING AREA TO AVOID Y FILES
	MOVEM C,LBLOCK		;A DAEMON WILL COPY INTO FILE AREA AFTER SALVAGE
	JSP TT,GTP
	MOVEM C,TUTPT		;INITIALIZE TUT POINTER
	MOVE C,DIR+UDESCP
	JSP TT,GBP
	MOVEM C,DIRPT		;INITIALIZE DESCRIPTOR AREA POINTER
	SETOB WRITE,BLKCNT	;FORCE NXTBW TO LOAD ADR
KA,	HRLOI BUFP,-2001-1	;SET UP BUFP SO FIRST WORD GOES IN DBUF+0
KL,	HRLOI BUFP,-2001
KS,	HRLOI BUFP,-2001
	MOVE D,[JRST 1]
	JSP P,WD		;END OF SBLK LOADER
;DROPS THROUGH

;DROPS IN
DUMP.5:	MOVSI WRITE,-'I(CMD)	;GET HERE IF VERIFY--SET WRITE NEGATIVE IF
	MOVEI B,40		;DUMP AND ZERO IF VERIFY--FIRST ADDR DUMPED IS 40
	HRRM B,DUMP4
	HLLOS DUMP6
	SETZM DUMP9S
	SETZM DUMP9J
	SETZM DUMP9K
	MOVEI B,DDT-3		;SET UP TO NOT DUMP SYMBOLS AS PART OF CORE IMAGE
	JSP P,FD
	 JSR EBUG,ERROR
	SKIPN A,(C)		;GET PNTR TO BUILT IN SYMBOLS
	 JRST DUMP4		;NO DDT, DON'T HACK THIS
	HRRM A,DUMP7		;THIS IS WHERE WE START DUMPING AGAIN
	MOVEM A,DUMP9K		;THIS WILL BE INITIAL SYMBOL TABLE PNTR WHEN DDT LOADED
	MOVNI A,(A)
	ADD A,1(C)		;GET MINUS SIZE OF NON-BUILTIN SYMBOL TABLE IN RH(A)
	HRL A,1(C)		;GET PNTR TO SYMBOL TABLE
	HLRM A,DUMP6		;THIS IS WHERE WE STOP DUMPING
	MOVSM A,DUMP9S		;SAVE AOBJN PNTR TO NON-BUILTIN SYMBOLS
	MOVE A,-1(C)		;PICK UP START ADDRESS
	MOVEM A,DUMP9J		;SAVE 
	MOVE B,-2(C)		;DUMP LOW CORE (ACS) OUT OF PLACE SAVED IN DDT
	HLLZ A,B		;HERE B HAS ADDRESS DUMPING FROM
	JRST DUMP3B		;AND A AND D HAVE VIRTUAL ADDRESS

DUMP1:	 			;SKIP OVER NXM ON DUMPING
KA,[	CONSO 10000 		;NXM SET?
	 JRST DUMP1A 		;NO, CONTINUE IN SEQUENCE
	ADDI B,10*2000-1	;SKIP 8K
	TRZ B,1777 		;ROUND DOWN TO 8K BOUDARY
	CONO 10000 		;CLEAR NXM
DUMP1A:
];KA
DUMP6:	CAIGE B,.		;SKIP IF REACHED SYMBOL TABLE
	 JRST DUMP8
DUMP7:	MOVEI B,.		;SKIP OVER SYMBOLS, DUMP DDT
	HLLOS DUMP6		;DEFUSE TEST
DUMP8:	JSP P,FD
	 JRST DUMPJ		;TIME TO WRITE JUMP BLOCK AND SYMBOL TABLE
	SKIPN (C)		;LOOK FOR NON-ZEROES
	 AOJA B,DUMP1
	MOVE A,B		;SAVE START OF BLOCK
DUMP2:	TLZ A,-1		;LOOK FOR TWO CONSECUTIVE ZEROES
DUMP2A:	CAIL B,200(A)		;BUT DON'T DUMP MORE THAN 200 WORDS AT A TIME
	 JRST DUMP3
	XCT DUMP6
	 JSP P,FD
	  JRST DUMP3		;END OF CORE, WRITE OUT LAST BLOCK
	SKIPE (C)
	 AOJA B,DUMP2		;NONZERO
	TLON A,-1		;ZERO, WAS PREV LOC ZERO ALSO?
	 AOJA B,DUMP2A		;NO, CHECK FOLLOWING LOC
	SOJA B,DUMP3		;YES, DUMP THE NON-ZERO THAT PRECEDES IT

DUMP3:	HRRM B,DUMP4		;SAVE ADDRESS TO CONTINUE SEARCH
	SUBM A,B		;RH(B) GETS MINUS THE LENGTH OF THE BLOCK
	HRL A,B			;SET UP HEADER IN A
	MOVE B,A		;AND B
DUMP3B:	MOVE D,A		;AND D
	JSP P,WD		;WRITE HEADER
DUMP3A:	JSP P,FD
	 JSR EBUG,ERROR		;CAN'T FETCH WORD WE FETCHED BEFORE??
	MOVE D,(C)
	ROT A,1
	ADD A,D			;COMPUTE CHECKSUM
	JSP P,WD		;WRITE DATA WORD
	AOBJN B,DUMP3A
	MOVE D,A
	JSP P,WD		;WRITE OUT CHECKSUM
DUMP4:	MOVEI B,.		;AND CONTINUE SEARCHING
	JUMPN B,DUMP1		;IF MRC EVER SEES THIS --SELFMODIFYING CODE-- ....
	JRST DUMP9		;FINISHED DUMPING SYMBOLS

DUMPJ:	SKIPN DUMP9K
	 JRST DMP9J1
	HRROI D,DDT-2		;BUGGER THE SYMBOL TABLE
	MOVE A,D
	JSP P,WD
	MOVE D,DUMP9K
	ROT A,1
	JSP P,WD
	ADD D,A
	JSP P,WD
DMP9J1:	SKIPN D,DUMP9J
	 MOVE D,SADR
	JSP P,WD		;WRITE OUT JUMP BLOCK
	SKIPN B,DUMP9S		;WRITE SYMBOLS
	 JRST DUMP9		;NO SYMBOLS
	HLLZ A,B
	HLLZS DUMP4		;DUMP SYMBOL BLOCK, RETURN TO DUMP9
	JRST DUMP3B

DUMP9:	JUMPE WRITE,LOADG1	;IF VERIFY, THAT'S ALL
	SKIPN D,DUMP9J
	 MOVE D,SADR
	JSP P,WD		;SECOND JUMP BLOCK
	HRRZ T,DMP4		; GET POINTER TO NAME AREA
	AOS BUFP
	DPB BUFP,[UNWRDC+DIR+UNRNDM(T)]
	JSP TT,NXTBLK
	JSP TT,WRDB		;WRITE OUT LAST BLOCK
	SKIPE T,BLKCNT
	 JSR NXTBW3		;STORE LAST DESCRIPTOR BYTE
	MOVEI T,0
	JSR NXTBW3		;AND INDICATE END OF FILE
	LDB T,[360600,,DIRPT]
	IDIVI T,6
	HRRZ TT,DIRPT
	IMULI TT,6
	SUBI TT,6*<DIR+UDDESC>-5-1(T)
	HRRZM TT,DIR+UDESCP	;INDICATE NEW END OF DESCRIPTOR AREA
KILDMP:	MOVEI UNIT,TUT
	MOVEI BLOK,TUTBLK
	JSP TT,WRD		;WRITE OUT TUT ON THIS UNIT
REPEAT NTUTBL-1,[
	ADDI UNIT,2000
	ADDI BLOK,1
	JSP TT,WRD
]
	HRRZ B,CU
	HRRM B,KD2		;WRITE OUT USER DIRECTORY ON ALL UNITS
KD1:	ADDI B,1
	CAIN B,NDSK
	 MOVEI B,0
	HRRM B,CU
	SKIPE QDED(B)
	 JRST KD2
	MOVEI UNIT,DIR
UDBLK:	MOVEI BLOK,.
	MOVE TT,DIR+UDNAME
	CAME TT,SYSN
	 JSR EBUG,ERROR
	JSP TT,WR
KD2:	CAIN B,.
	 JRST LOADG1
	JRST KD1

GTP:	SKIPGE TUT+QPKNUM
	 JSR EBUG,ERROR		;MUST BE OLD-STYLE TUT?
	SUB C,TUT+QFRSTB
	JUMPL C,[JSR EBUG,ERROR]
	IDIVI C,TUTEPW
	IMULI A,-10000*TUTBYT
	HRLI C,440000+TUTBYT_6(A)
	ADDI C,TUT+LTIBLK
	JRST (TT)

SC,[	;LOGICAL TO PHYSICAL DISK MAPPING
QTRAN:	0	;INDEX BY LOG DSK #
	1	;4.9 => USE HIGH HALF OF DRIVE, RH = PHYS DRIVE #
	2	;(NO LONGER DOES ANYTHING, NOW THAT MEMOWRECKS ARE GONE,
	3	; BUT KEEP AROUND JUST IN CASE EVER NEEDED AGAIN.)
	4
	5
	6
	7
IFL .-QTRAN-NDSK,.ERR QTRAN LOSES!!
];SC

ERRCT:	0		;ERROR COUNTER
DDTM2:	0		;DDT SYMBOL TABLE POINTER
DUMP9J:	0		;START INSTRUCTION (AT DUMP9)
DUMP9S:	0		;SYMBOL TABLE POINTER (AT DUMP9)
DUMP9K:	0		;INITIAL SYMBOL TABLE PNTR (AT DUMP9)
LBLOCK:	0		;LAST BLOCK WRITTEN OR READ
BLKCNT:	0		;NUMBER OF BLOCKS READ OR WRITTEN CONSECUTIVELY
DIRPT:	0		;DESCRIPTOR AREA BYTE POINTER
TUTPT:	0		;TUT BYTE POINTER
FN1:	0		;FILE NAME 1
FN2:	0		;FILE NAME 2
PKNUM:	REPEAT NDSK,-1	;PACK NUMBER INDEXED BY DRIVE NUMBER
QDED:	BLOCK NDSK	;-1 IF DRIVE NOT TO BE USED
XWDS:	BLOCK 4
RPKID:	0
BOOTNS:	RP, CONSZ DPC,BUSY
	SC, CONSZ DC0,DSSACT
	RH, CONSZ DSK,%HIBSY
	PH, IORD B,SWPCS1	; UGH!

	CONSTANTS

IFL BEG+1677-., .ERR BLOAT
INFORM SPACE LEFT,\BEG+1677-.
BLOCK BEG+1677-.

BADBLK:	0		;BLOCK WITH HDWE ERROR
INFORM BADBLK,\.-1-BEG+<MEMSIZ-2000>

];END IFE BOOTSW
IFN BOOTSW,[
BEG=MEMSIZ-2000
LOC MEMSIZ-100
]

CBOOT:	CLEARM MEMSIZ-1		;BOOTSTRAP
RP,[
BOOT:
IFE BOOTSW,	JRST BEG	;OR CONSZ DPC,BUSY OR JRST LOADG1
IFN BOOTSW,	CONSZ DPC,BUSY
	 JRST .-1
	MOVEI B,ICWA+2		;SET UP CHANNEL PROG
	MOVEM B,ICWA
	SETZM ICWA+1
	SETZM ICWA+3
	DATAO DPC,CLATT1
	DATAO DPC,SUNIT0
	DATAI DPC,B
BOOT0:	TRNN B,RP03BT
	 JRST BOOT1
	MOVEI B,MBLKS		;UNIT 0 IS AN RP03, ADJUST WORLD
	HRRM B,CBLK
	MOVE B,RP3ADJ
	MOVSI A,-NSWBL
	XORM B,SWPSK(A)
	AOBJN A,.-1
BOOT1:	HLLZS BOOT0		;PREVENT TRNN FROM SKIPPING AGAIN
	MOVE B,ERRWD
	MOVEM B,@ICWA
	DATAO DPC,SWPSK
	JSP P,SKWAIT
	DATAO DPC,SWPIN1
	CONSO DPC,DONE
	 JRST .-1
	DATAO DPC,SWPIN2
	CONSO DPC,DONE
	 JRST .-1
	JRST BEG

ERRWD:	-1700,,BEG-1
CLATT1:	DEASEC ALLATT
SWPSK:	DSEEKC+200._22.
SWPIN1:	DWRITC+200._22.+3_17.+2._12.+ICWA	;NBLKS 4
SWPIN2:	DREADC+200._22.+4_17.+8._12.+ICWA
SWPOU1:	DWRITC+200._22.+4_17.+8._12.+ICWA
SWPOU2:	DREADC+200._22.+3_17.+2_12.+ICWA
IFN NSWBL-5, .ERR THE PRECEDING 4 CONSTANTS ARE WRONG!
CBLK:	-NSWBL,,NBLKS			;DISK ADDR OF CORE BUFFER, - # BLOCKS IN LH
RP3ADJ:	<<MCYLS#NCYLS>&377>_22.+<.BM DCYLXB>
SUNIT0:	DNOOPC

SKWAIT:	DATAI DPC,A		;AWAIT SEEK DONE UNIT 0
	TRNN A,ALLATT
	 JRST SKWAIT
	DATAO DPC,CLATT1
	MOVEI A,30.
	SOJG A,.
	DATAI DPC,A
	TLNN A,(ONCYL)
	 JRST SKWAIT
	JRST (P)

WAIT:	CONSO DPC,DONE
	 JRST .-1
];RP

PH,[	;; Initially we could not use IORDQ or IOWRQ because they were
	;; macros that used a literal.  There is nothing to stop us now,
	;; except the fact that this code works fine and is as small as you
	;; could possibly want.

BOOT:
IFE BOOTSW, JRST BEG		; or IORD B,SWPCS1 or JRST LOADG1
IFN BOOTSW, IORD B,SWPCS1
	TRNN B,%HXRDY
	 JRST BOOT
KS,	WREBR 0			; No paging or caching
	MOVEI A,0
	IOWR A,SWPCS2		; Select drive
BOOT0:	IORD A,SWPCS1
	TRNN A,%HXDVA
	 JRST BOOT0		; Await drive available
	MOVSI B,-LSWPADR
BOOT1:	HLRZ A,SWPVAL(B)
	IOWR A,SWPADR(B)
BOOT2:	IORD A,SWPCS1
	TRNN A,%HXRDY		; Wait for controller
	 JRST BOOT2
	TRNE A,%HXTRE+%HXMCP	; Lossage?
	 JRST 4,.		; Foo!
	AOBJN B,BOOT1
	JRST BEG

ZZ1==<NSWBL-1>*SECBLK	;BLOCK CONTAINING CORE SWAPPED OUT TO BRING DSKDMP IN
ZZ2==<NSWBL>*SECBLK	;DSKDMP RESIDENCE BLOCK
ZZ3==ZZ1/NSECS
ZZ4==ZZ2/NSECS
ZZ1==ZZ3*400+<ZZ1-NSECS*ZZ3>	;CONVERT ADDR TO DISK FORMAT
ZZ2==ZZ4*400+<ZZ2-NSECS*ZZ4>

SWPADR:	UBAQ,,UBAPAG+UBPG_1	; Set up Unibus map
	UBAQ,,UBAPAG+UBPG_1+1
	UBAQ,,%HRCS2		; Clear controller
SWPCS2:	UBAQ,,%HRCS2		; Select drive
SWPCS1:	UBAQ,,%HRCS1		; Initialize
	UBAQ,,%HRCYL		; Desire cylinder
	UBAQ,,%HRWC		; Set (half) word count
	UBAQ,,%HRBA		; Set Unibus address
	UBAQ,,%HRADR		; Desire track and sector
	UBAQ,,%HRCS1		; Write
	UBAQ,,%HRWC		; Reset (half) word count
	UBAQ,,%HRBA		; Reset Unibus address
	UBAQ,,%HRADR		; Desire track and sector
	UBAQ,,%HRCS1		; Read
LSWPADR==:.-SWPADR

IFN BEG&1777, .ERR BEG does not lie on a page boundary?

;;; LH FOR SWAP IN, RH FOR SWAP OUT
SWPVAL:	%UQVAL+%UQFST+BEG_-9,,%UQVAL+%UQFST+BEG_-9	; Set up Unibus map
	%UQVAL+%UQFST+BEG_-9+1,,%UQVAL+%UQFST+BEG_-9+1
	%HYCLR,,%HYCLR		; Clear controller
	0,,0			; Select drive
	%HMRDP,,%HMRDP		; Initialize
	NCYLS,,NCYLS		; Desire cylinder
	-1700*2,,-1700*2	; Set (half) word count
	UBPG_14,,UBPG_14	; Set Unibus address
	ZZ1,,ZZ2		; Desire track and sector
	%HMWRT,,%HMWRT		; Write
	-1700*2,,-1700*2	; Reset (half) word count
	UBPG_14,,UBPG_14	; Reset Unibus address
	ZZ2,,ZZ1		; Desire track and sector
	%HMRED,,%HMRED		; Read
IFN .-SWPVAL-LSWPADR, .ERR SWPVAL wrong length.

CBLK:	-NSWBL,,NBLKS

WAIT:	IORD B,SWPCS1
	TRNN B,%HXRDY
	 JRST WAIT
];PH

RH,[
BOOT:
IFE BOOTSW,	JRST BEG	;OR CONSZ DSK,%HIBSY OR JRST LOADG1
IFN BOOTSW,	CONSZ DSK,%HIBSY
	 JRST .-1
KL,	CONSZ PAG,660000	;PAGING AND CACHE MUST BE DISABLED
KL,	 JRST 4,.
	MOVEI B,ICWA+2		;SET UP CHANNEL PROG
	MOVEM B,ICWA
	SETZM ICWA+1
	SETZM ICWA+3
BOOT0:	DATAO DSK,[%HRDCL,,]
	MOVEI A,20
	SOJG A,.
	DATAI DSK,A
	TRNN A,%HCDVA
	 JRST BOOT0		;AWAIT DRIVE AVAILABLE
	MOVE B,ERRWD
	CONI DSK,A
	TLNE A,(%HID22)
	 HRLI B,-1700_4
	MOVEM B,@ICWA
	MOVSI B,-6
BOOT1:	DATAO DSK,SWPIN1(B)
	MOVEI A,20
	SOJG A,.
	CONSZ DSK,%HIBSY
	 JRST .-1
	AOBJN B,BOOT1
	CONSZ DSK,%HIERR
	 JRST 4,.
	JRST BEG

ZZ1==<NSWBL-1>*SECBLK	;BLOCK CONTAINING CORE SWAPPED OUT TO BRING DSKDMP IN
ZZ2==<NSWBL>*SECBLK	;DSKDMP RESIDENCE BLOCK
ZZ3==ZZ1/NSECS
ZZ4==ZZ2/NSECS
ZZ1==ZZ3*400+<ZZ1-NSECS*ZZ3>	;CONVERT ADDR TO DISK FORMAT
ZZ2==ZZ4*400+<ZZ2-NSECS*ZZ4>

ERRWD:	-1700,,BEG-1
SWPIN1:	%HRLOD+%HRDCL,,%HMRDP
SWPIN2:	%HRLOD+%HRCYL,,NCYLS+1	;AVOID CYLINDER 406 WHICH KLDCP USES
SWPIN3:	%HRLOD+%HRADR,,ZZ1
SWPIN4:	%HRLOD+%HRCTL,,%HMWRT+ICWA_6
SWPIN5:	%HRLOD+%HRADR,,ZZ2
SWPIN6:	%HRLOD+%HRCTL,,%HMRED+ICWA_6

SWPOU1:	%HRLOD+%HRDCL,,%HMRDP
SWPOU2:	%HRLOD+%HRCYL,,NCYLS+1	;AVOID CYLINDER 406 WHICH KLDCP USES
SWPOU3:	%HRLOD+%HRADR,,ZZ2
SWPOU4:	%HRLOD+%HRCTL,,%HMWRT+ICWA_6
SWPOU5:	%HRLOD+%HRADR,,ZZ1
SWPOU6:	%HRLOD+%HRCTL,,%HMRED+ICWA_6

CBLK:	-NSWBL,,NBLKS+NBLKSC	;AVOID CYLINDER 406 WHICH KLDCP USES

WAIT:	CONSO DSK,%HIDON
	 JRST .-1
];RH

SC,[
BOOT:
IFE BOOTSW,	JRST BEG	;OR CONSZ DC0,DSSACT OR JRST LOADG1
IFN BOOTSW,	CONSZ DC0,DSSACT
	 JRST .-1
	DATAO DC0,SWPINJ
	CONSZ DC0,DSSACT
	 JRST .-1
	JRST BEG

SWPINJ:	DJMP SWPIN

DADR==NCYLS_13+<<NSWBL-1>/2>_6+<<NSWBL-1>&1>	;ADDR OF LAST BLOCK IN CORE BUFFER
DADR1==NCYLS_13+<NSWBL/2>_6+<NSWBL&1>		;ADDR OF NEXT BLOCK (CONTAINS
SWPIN:	DWRITE+DUNENB+DADR			; WORKING COPY OF DSKDMP)
	DCOPY BEG(-2000_2&37774)
	DCSKIP (-4_2&37774)
	DRC+DADR
	DCOPY BEG(-2000_2&37774)
	DCSKIP (-4_2&37774)
	DREAD+DADR1
	DCOPY BEG(-1700_2&37774)
	DCSKIP (-104_2&37774)
	DRC+DADR1
	DCOPY BEG(-1700_2&37774)
	DCSKIP (-104_2&37774)
	DHLT

SWPOUT:	DWRITE+DUNENB+DADR1
	DCOPY BEG(-2000_2&37774)
	DCSKIP (-4_2&37774)
	DRC+DADR1
	DCOPY BEG(-2000_2&37774)
	DCSKIP (-4_2&37774)
	DREAD+DADR
	DCOPY BEG(-1700_2&37774)
	DCSKIP (-104_2&37774)
	DRC+DADR
	DCOPY BEG(-1700_2&37774)
	DCSKIP (-104_2&37774)
	DHLT

CBLK:	-NSWBL,,NBLKS		;DISK ADDR OF CORE BUFFER, - # BLOCKS IN LH
WAIT:	CONSZ DC0,DSSACT
	 JRST .-1
];SC
SADR:	JRST BOOT		;AND GO TO PROGRAM TO BE STARTED
SYSN:	SIXBIT /./		;CURRENT DIRECTORY
IFG .+1-MEMSIZ,.ERR BOOT BLOAT

IFE BOOTSW,{			;CURLY BRACKETS TO AVOID ERROR MESSAGE
	OFFSET 0
	LOC CORE

;THESE ARE THE BLOCKS THAT GET WRITTEN ON DISK
; STARTING AT THE BEGINNING OF THE FIRST EXTRA CYLINDER

CBUF:	BLOCK 2000		;PSEUDO-CORE BUFFER
DBUF:	BLOCK 2000		;DISK BUFFER
DIR:	BLOCK 2000		;DIRECTORY BUFFER
TUT:	BLOCK 2000*NTUTBL	;TUT BUFFER
IFN .-BEG,.ERR BLOCKS LOST
;	BLOCK 2000		;CORE OVERLAYED BY DSKDMP
;	BLOCK 2000		;COPY OF DSKDMP
;	BLOCK 2000		;SPARE COPY OF DSKDMP

END ZZZ
};END IFE BOOTSW
IFN BOOTSW, END CBOOT
